home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / 1.6.0 / ice-9 / buffered-input.scm < prev    next >
Encoding:
Text File  |  2004-01-06  |  5.8 KB  |  133 lines
  1. ;;;; buffered-input.scm --- construct a port from a buffered input reader
  2. ;;;;
  3. ;;;;     Copyright (C) 2001 Free Software Foundation, Inc.
  4. ;;;; 
  5. ;;;; This program is free software; you can redistribute it and/or modify
  6. ;;;; it under the terms of the GNU General Public License as published by
  7. ;;;; the Free Software Foundation; either version 2, or (at your option)
  8. ;;;; any later version.
  9. ;;;; 
  10. ;;;; This program is distributed in the hope that it will be useful,
  11. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ;;;; GNU General Public License for more details.
  14. ;;;; 
  15. ;;;; You should have received a copy of the GNU General Public License
  16. ;;;; along with this software; see the file COPYING.  If not, write to
  17. ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18. ;;;; Boston, MA 02111-1307 USA
  19. ;;;;
  20. ;;;; As a special exception, the Free Software Foundation gives permission
  21. ;;;; for additional uses of the text contained in its release of GUILE.
  22. ;;;;
  23. ;;;; The exception is that, if you link the GUILE library with other files
  24. ;;;; to produce an executable, this does not by itself cause the
  25. ;;;; resulting executable to be covered by the GNU General Public License.
  26. ;;;; Your use of that executable is in no way restricted on account of
  27. ;;;; linking the GUILE library code into it.
  28. ;;;;
  29. ;;;; This exception does not however invalidate any other reasons why
  30. ;;;; the executable file might be covered by the GNU General Public License.
  31. ;;;;
  32. ;;;; This exception applies only to the code released by the
  33. ;;;; Free Software Foundation under the name GUILE.  If you copy
  34. ;;;; code from other Free Software Foundation releases into a copy of
  35. ;;;; GUILE, as the General Public License permits, the exception does
  36. ;;;; not apply to the code that you add in this way.  To avoid misleading
  37. ;;;; anyone as to the status of such modified files, you must delete
  38. ;;;; this exception notice from them.
  39. ;;;;
  40. ;;;; If you write modifications of your own for GUILE, it is your choice
  41. ;;;; whether to permit this exception to apply to your modifications.
  42. ;;;; If you do not wish that, delete this exception notice.
  43.  
  44. (define-module (ice-9 buffered-input)
  45.   #:export (make-buffered-input-port
  46.             make-line-buffered-input-port
  47.             set-buffered-input-continuation?!))
  48.  
  49. ;; @code{buffered-input-continuation?} is a property of the ports
  50. ;; created by @code{make-line-buffered-input-port} that stores the
  51. ;; read continuation flag for each such port.
  52. (define buffered-input-continuation? (make-object-property))
  53.  
  54. (define (set-buffered-input-continuation?! port val)
  55.   "Set the read continuation flag for @var{port} to @var{val}.
  56.  
  57. See @code{make-buffered-input-port} for the meaning and use of this
  58. flag."
  59.   (set! (buffered-input-continuation? port) val))
  60.  
  61. (define (make-buffered-input-port reader)
  62.   "Construct a line-buffered input port from the specified @var{reader}.
  63. @var{reader} should be a procedure of one argument that somehow reads
  64. a chunk of input and returns it as a string.
  65.  
  66. The port created by @code{make-buffered-input-port} does @emph{not}
  67. interpolate any additional characters between the strings returned by
  68. @var{reader}.
  69.  
  70. @var{reader} should take a boolean @var{continuation?} argument.
  71. @var{continuation?} indicates whether @var{reader} is being called to
  72. start a logically new read operation (in which case
  73. @var{continuation?} is @code{#f}) or to continue a read operation for
  74. which some input has already been read (in which case
  75. @var{continuation?} is @code{#t}).  Some @var{reader} implementations
  76. use the @var{continuation?} argument to determine what prompt to
  77. display to the user.
  78.  
  79. The new/continuation distinction is largely an application-level
  80. concept: @code{set-buffered-input-continuation?!} allows an
  81. application to specify when a read operation is considered to be new.
  82. But note that if there is non-whitespace data already buffered in the
  83. port when a new read operation starts, this data will be read before
  84. the first call to @var{reader}, and so @var{reader} will be called
  85. with @var{continuation?} set to @code{#t}."
  86.   (let ((read-string "")
  87.     (string-index -1))
  88.     (letrec ((get-character
  89.           (lambda ()
  90.         (cond 
  91.          ((eof-object? read-string)
  92.           read-string)
  93.          ((>= string-index (string-length read-string))
  94.           (set! string-index -1)
  95.                   (get-character))
  96.          ((= string-index -1)
  97.           (set! read-string (reader (buffered-input-continuation? port)))
  98.                   (set! string-index 0)
  99.                   (if (not (eof-object? read-string))
  100.                       (get-character)
  101.                       read-string))
  102.          (else
  103.           (let ((res (string-ref read-string string-index)))
  104.             (set! string-index (+ 1 string-index))
  105.                     (if (not (char-whitespace? res))
  106.                         (set! (buffered-input-continuation? port) #t))
  107.             res)))))
  108.              (port #f))
  109.       (set! port (make-soft-port (vector #f #f #f get-character #f) "r"))
  110.       (set! (buffered-input-continuation? port) #f)
  111.       port)))
  112.  
  113. (define (make-line-buffered-input-port reader)
  114.   "Construct a line-buffered input port from the specified @var{reader}.
  115. @var{reader} should be a procedure of one argument that somehow reads
  116. a line of input and returns it as a string @emph{without} the
  117. terminating newline character.
  118.  
  119. The port created by @code{make-line-buffered-input-port} automatically
  120. interpolates a newline character after each string returned by
  121. @var{reader}.
  122.  
  123. @var{reader} should take a boolean @var{continuation?} argument.  For
  124. the meaning and use of this argument, see
  125. @code{make-buffered-input-port}."
  126.   (make-buffered-input-port (lambda (continuation?)
  127.                               (let ((str (reader continuation?)))
  128.                                 (if (eof-object? str)
  129.                                     str
  130.                                     (string-append str "\n"))))))
  131.  
  132. ;;; buffered-input.scm ends here
  133.